﻿Module NelderMead_01
 
    Public caso
    Public IterMax
    Public Minimize As Boolean
    Public Box(,)
    Public Xscale()
    'Public variables(1 To 3) As Double
    Public variables(2) As Double
    Public cobjetivo As Double
    Public Constrain As Boolean
    'Public rango(1 To 3, 1 To 2) As Double
    Public rango(2, 1) As Double

    'Public variables6(4) As Double
    ''Public rango(1 To 3, 1 To 2) As Double
    'Public rango6(4, 1) As Double
    Public Objetivo() As Decimal
    Public Px1() As Decimal
    Public Px2() As Decimal
    Public Px3() As Decimal
    'Public Px1() As Decimal
    'Public Px2() As Decimal
    'Public Px3() As Decimal



    Function getFunct(ByVal x As Object, ByRef frm As Form2)
        'worksheet function to minimize
        Dim i As Integer
        frm.TP1.Text = Xscale(0) * x(0)
        frm.TP2.Text = Xscale(1) * x(1)
        frm.TP3.Text = Xscale(2) * x(2)
        frm.TP4.Text = Xscale(3) * x(3)
        frm.TP5.Text = Xscale(4) * x(4)


        variables(0) = frm.TP1.Text
        variables(1) = frm.TP2.Text
        variables(2) = frm.TP3.Text
        variables(3) = frm.TP4.Text
        variables(4) = frm.TP5.Text

        Dim sumatoria As Decimal = 0

        For i = 0 To frm.DataGridView1.Rows.Count - 1

            Dim k1 As Decimal = frm.TP1.Text.Replace(".", ",")
            Dim k2 As Decimal = frm.TP2.Text.Replace(".", ",")
            Dim k3 As Decimal = frm.TP3.Text.Replace(".", ",")
            Dim k4 As Decimal = frm.TP4.Text.Replace(".", ",")
            Dim k5 As Decimal = frm.TP5.Text.Replace(".", ",")


            Dim A As Decimal = (frm.DataGridView1(0, i).Value)
            Dim B As Decimal = (frm.DataGridView1(1, i).Value)

            Dim C As Decimal '= (frm.valor1 * (1 - Math.Exp(-k2 * A ^ k3)) * frm.valor2)

            C = (k1 * B ^ k4 - (k2 * frm.valor1 + k3) * (1 - Math.Exp(-k5 * frm.valor2 / (frm.valor3 + frm.valor4)))) * (frm.valor1 / frm.valor5) ^ frm.valor6

            Dim D As Decimal = 0
            Try
                D = (A - C) ^ 2
                '(Math.Log10(CDec(DataGridView1(1, e.RowIndex).Value)) - Math.Log10(DataGridView1(2, e.RowIndex).Value)) ^ 2
            Catch ex As Exception

            End Try


            '(C - B) ^ 2

            frm.DataGridView1(2, i).Value = FormatNumber(C, 2)
            frm.DataGridView1(3, i).Value = FormatNumber(D, 2)

            sumatoria = sumatoria + FormatNumber(D, 2)
        Next

        'For i = 0 To UBound(x) - 1
        '    variables(i) = Xscale(i) * x(i)


        '    'Cells(i + 21, 3) = variables(i)
        '    'ObjExcel.Cells(i + 3, 7).value = variables(i)
        'Next i
        cobjetivo = sumatoria 'Cells(22, 5)
        'cobjetivo = ObjExcel.Cells(3, 9).value
        Application.DoEvents()
        If Minimize Then
            getFunct = cobjetivo
        Else
            getFunct = -cobjetivo
        End If
    End Function


    Function getFunct(ByVal x As Object, ByRef frm As Form1)
        'worksheet function to minimize
        Dim i As Integer
        frm.TP1.Text = FormatNumber(Xscale(0) * x(0), 4)
        frm.TP2.Text = FormatNumber(Xscale(1) * x(1), 4)
        frm.TP3.Text = FormatNumber(Xscale(2) * x(2), 4)

        variables(0) = frm.TP1.Text
        variables(1) = frm.TP2.Text
        variables(2) = frm.TP3.Text

        Dim sumatoria As Decimal = 0

        For i = 0 To frm.DataGridView1.Rows.Count - 1

            Dim p1 As Decimal = frm.TP1.Text.Replace(".", ",")
            Dim p2 As Decimal = frm.TP2.Text.Replace(".", ",")
            Dim p3 As Decimal = frm.TP3.Text.Replace(".", ",")

            Dim A As Decimal = (frm.DataGridView1(0, i).Value)
            Dim B As Decimal = (frm.DataGridView1(1, i).Value)

            Dim C As Decimal = (frm.valor1 * (1 - Math.Exp(-p2 * A ^ p3)) * frm.valor2)

            Dim D As Decimal = 0
            Try
                D = (B - C) ^ 2
                '(Math.Log10(CDec(DataGridView1(1, e.RowIndex).Value)) - Math.Log10(DataGridView1(2, e.RowIndex).Value)) ^ 2
            Catch ex As Exception

            End Try


            '(C - B) ^ 2

            frm.DataGridView1(2, i).Value = FormatNumber(C, 2)
            frm.DataGridView1(3, i).Value = FormatNumber(D, 2)

            sumatoria = sumatoria + FormatNumber(D, 2)
        Next

        'For i = 0 To UBound(x) - 1
        '    variables(i) = Xscale(i) * x(i)


        '    'Cells(i + 21, 3) = variables(i)
        '    'ObjExcel.Cells(i + 3, 7).value = variables(i)
        'Next i
        If Objetivo Is Nothing Then
            ReDim Objetivo(0)
            ReDim Px1(0)
            ReDim Px2(0)
            ReDim Px3(0)
        Else
            ReDim Preserve Objetivo(Objetivo.Length)
            ReDim Preserve Px1(Px1.Length)
            ReDim Preserve Px2(Px1.Length)
            ReDim Preserve Px3(Px1.Length)
        End If


        Objetivo(Objetivo.Length - 1) = sumatoria
        Px1(Px1.Length - 1) = frm.TP1.Text
        Px2(Px2.Length - 1) = frm.TP2.Text
        Px3(Px3.Length - 1) = frm.TP3.Text


        cobjetivo = sumatoria 'Cells(22, 5)
        'cobjetivo = ObjExcel.Cells(3, 9).value
        Application.DoEvents()
        If Minimize Then
            getFunct = cobjetivo
        Else
            getFunct = -cobjetivo
        End If
    End Function

    Sub XScaling(ByRef x)
        'rescale the variables with an adapt factor
        Dim i&, n&, m&, p
        n = UBound(x)
        'ReDim Xscale(1 To n)
        ReDim Xscale(n)

        On Error Resume Next
        m = UBound(x, 2)
        'If Err.Number = 0 Then
        'it's a box-matrix
        For i = 0 To n
            p = ScaleFactor(x(i, 1) - x(i, 0))
            Xscale(i) = 10 ^ (p)
            x(i, 0) = x(i, 0) / Xscale(i)
            x(i, 1) = x(i, 1) / Xscale(i)
        Next i
        'Else
        ''it's a vector
        'For i = 0 To n
        '    p = ScaleFactor(x(i))
        '    Xscale(i) = 10 ^ p
        '    x(i) = x(i) / Xscale(i)
        'Next i
        'End If
    End Sub

    Function ScaleFactor(ByVal A)
        Dim n&
        If A <> 0 Then
            ScaleFactor = (Math.Log10(Math.Abs(A)) / Math.Log(10.0#))
        Else
            ScaleFactor = 0
        End If
    End Function

    Sub NoScaling(ByVal x)
        Dim n&, i&
        n = UBound(x)
        'ReDim Xscale(1 To n)
        ReDim Xscale(n)
        For i = 1 To n
            Xscale(i) = 1
        Next i
    End Sub

    Sub getConstrainBox(ByRef Box)
        Dim tmp, n&, i&
        n = variables.Length '- 1
        'ReDim Box(1 To n, 1 To 2)
        ReDim Box(n - 1, 1)
        tmp = rango
        For i = 0 To n - 1
            Box(i, 0) = tmp(i, 0)       'Xmin
            Box(i, 1) = tmp(i, 1)       'Xmax
        Next i

    End Sub

    Sub Constrain_Point(ByVal x)
        Dim i As Long, n As Long
        n = UBound(x)
        For i = 0 To n - 1
            'fix the constrain coordinate x
            If Box(i, 0) > x(i) Then x(i) = Box(i, 0)
            If Box(i, 1) < x(i) Then x(i) = Box(i, 1)
        Next i

    End Sub


    '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++'

    Sub NMSimplex(ByRef Frm As Form1, ByVal x(,) As Double, ByVal xsol() As Double, ByVal ysol As Double, ByVal tol As Double, ByVal itmax As Long, ByVal its As Long, Optional ByVal Constrain As Boolean = True)
        ' Rutina para buscar el minimo de una funcion segun el algoritmo de Nelder Mead
        ' y = fun(x1,x2,...,xn) funcion de R^n a R que se desea optimizar
        ' x(1 to n+1,1 to n) vertices del Simplex inicial
        ' xsol(1 to n), ysol=fun(xsol) solucion del problema
        '
        ' Bibliografia
        ' Numerical Recipies in Fortran77; W.H. Press, et al.; Cambridge U. Press
        ' Metodos numericos con Matlab; J. M Mathewss et al.; Prentice Hall
        ' E. Chelouan, et al.; Genetic and Nelder-Mead...; EJOR 148(2003) 335-348
        ' J.C. Lagarias, et al.; Convergence properties...; SIAM J Optim. 9(1), 112-147
        '
        Dim n As Integer    'Dimension del espacio de busqueda
        Dim y() As Double

        'Reflexion, expansion, 'contracciones y centro de masas del simplex
        Dim cm() As Double, r() As Double, e() As Double, c() As Double, cc() As Double
        Dim yr As Double, ye As Double, yc As Double, ycc As Double, ycm As Double

        Dim delta As Double                  ' tolerancias

        Dim tp() As Double
        Dim i As Integer, j As Integer, k As Integer

        n = UBound(x, 1)            'Dimension del espacio de busqueda
        ReDim cm(n), r(n), e(n), c(n), cc(n)
        ReDim xsol(n), tp(n), y(n + 1)

        ' On Error GoTo Error_Handler

        For i = 0 To n - 1       'Evaluamos la funcion en los vertices del simplex
            For j = 0 To n - 1
                tp(j) = x(i, j)
            Next
            If Constrain = True Then Constrain_Point(tp)
            y(i) = getFunct(tp, Frm)
        Next

        Call Orden(x, y)            'Ordenamos los vertices de mejor a peor solucion

        its = 0
        delta = 1
        Do While delta >= tol And its < itmax         ' Comienzo de las iteraciones
            For i = 0 To n - 1      ' Calculo del centro de masas de los n mejores puntos
                cm(i) = 0
                For j = 0 To n
                    cm(i) = cm(i) + x(j, i)
                Next
                cm(i) = cm(i) / n
            Next

            For i = 0 To n - 1        ' Reflexion del simplex respecto de su centro de masas
                r(i) = 2 * cm(i) - x(n, i)
            Next
            If Constrain = True Then Constrain_Point(r)
            yr = getFunct(r, Frm)

            If yr < y(n) Then               'Arbol de decision del Simplex
                If y(1) <= yr Then          'Aceptamos r
                    For i = 0 To n - 1
                        x(n, i) = r(i)
                    Next
                    y(n) = yr
                Else
                    For i = 0 To n - 1      'Expansion del simplex respecto de su centro de masas
                        e(i) = 3 * cm(i) - 2 * x(n, i)
                    Next
                    If Constrain = True Then Constrain_Point(e)
                    ye = getFunct(e, Frm)

                    If ye < yr Then     'Aceptamos e
                        For i = 0 To n - 1
                            x(n, i) = e(i)
                        Next
                        y(n) = ye
                    Else
                        For i = 0 To n - 1  'Aceptamos r
                            x(n, i) = r(i)
                        Next
                        y(n) = yr
                    End If
                End If
            Else
                If yr < y(n + 1) Then
                    For i = 1 To n          ' Contraccion hacia fuera del simplex
                        c(i) = (3 / 2) * cm(i) - (1 / 2) * x(n + 1, i)
                    Next
                    If Constrain = True Then Constrain_Point(c)
                    yc = getFunct(c, Frm)

                    If yc <= yr Then
                        For i = 1 To n  'Aceptamos c
                            x(n + 1, i) = c(i)
                        Next
                        y(n + 1) = yc
                    Else
                        For i = 2 To n + 1      ' Contraccion general del simplex hacia el vertice 1
                            For k = 1 To n
                                x(i, k) = (1 / 2) * (x(1, k) + x(i, k))
                                tp(k) = x(i, k)
                            Next
                            If Constrain = True Then Constrain_Point(tp)
                            y(i) = getFunct(tp, Frm)
                        Next
                    End If
                Else
                    For i = 0 To n - 1       ' Contraccion hacia dentro del simplex
                        cc(i) = (1 / 2) * (cm(i) + x(n, i))
                    Next
                    If Constrain = True Then Constrain_Point(cc)
                    ycc = getFunct(cc, Frm)

                    If ycc < y(n + 1) Then  'Aceptamos c
                        For i = 0 To n - 1
                            x(n, i) = cc(i)
                        Next
                        y(n + 1) = ycc
                    Else

                        For i = 1 To n        ' Contraccion general del simplex hacia el vertice 1
                            For k = 0 To n - 1
                                x(i, k) = (1 / 2) * (x(1, k) + x(i, k))
                                tp(k) = x(i, k)
                            Next
                            If Constrain = True Then Constrain_Point(tp)
                            y(i) = getFunct(tp, Frm)
                        Next
                    End If
                End If
            End If

            Call Orden(x, y)        'Ordenamos los vertices de mejor a peor solucion

            delta = 2 * Math.Abs(y(1) - y(n)) / (Math.Abs(y(1)) + Math.Abs(y(n)) + 0.0000000001)
            its = its + 1
        Loop

        For i = 0 To n - 1
            xsol(i) = x(1, i)
        Next
        ysol = y(1)
        Exit Sub
        '
        'Error_Handler:
        '        Err.Raise(vbObjectError + 513, , Err.Description)
    End Sub

    Sub NMSimplex(ByRef Frm As Form2, ByVal x(,) As Double, ByVal xsol() As Double, ByVal ysol As Double, ByVal tol As Double, ByVal itmax As Long, ByVal its As Long, Optional ByVal Constrain As Boolean = True)
        ' Rutina para buscar el minimo de una funcion segun el algoritmo de Nelder Mead
        ' y = fun(x1,x2,...,xn) funcion de R^n a R que se desea optimizar
        ' x(1 to n+1,1 to n) vertices del Simplex inicial
        ' xsol(1 to n), ysol=fun(xsol) solucion del problema
        '
        ' Bibliografia
        ' Numerical Recipies in Fortran77; W.H. Press, et al.; Cambridge U. Press
        ' Metodos numericos con Matlab; J. M Mathewss et al.; Prentice Hall
        ' E. Chelouan, et al.; Genetic and Nelder-Mead...; EJOR 148(2003) 335-348
        ' J.C. Lagarias, et al.; Convergence properties...; SIAM J Optim. 9(1), 112-147
        '
        Dim n As Integer    'Dimension del espacio de busqueda
        Dim y() As Double

        'Reflexion, expansion, 'contracciones y centro de masas del simplex
        Dim cm() As Double, r() As Double, e() As Double, c() As Double, cc() As Double
        Dim yr As Double, ye As Double, yc As Double, ycc As Double, ycm As Double

        Dim delta As Double                  ' tolerancias

        Dim tp() As Double
        Dim i As Integer, j As Integer, k As Integer

        n = UBound(x, 1)            'Dimension del espacio de busqueda
        ReDim cm(n), r(n), e(n), c(n), cc(n)
        ReDim xsol(n), tp(n), y(n + 1)

        ' On Error GoTo Error_Handler

        For i = 0 To n - 1       'Evaluamos la funcion en los vertices del simplex
            For j = 0 To n - 1
                tp(j) = x(i, j)
            Next
            If Constrain = True Then Constrain_Point(tp)
            y(i) = getFunct(tp, Frm)
        Next

        Call Orden(x, y)            'Ordenamos los vertices de mejor a peor solucion

        its = 0
        delta = 1
        Do While delta >= tol And its < itmax         ' Comienzo de las iteraciones
            For i = 0 To n - 1      ' Calculo del centro de masas de los n mejores puntos
                cm(i) = 0
                For j = 0 To n
                    cm(i) = cm(i) + x(j, i)
                Next
                cm(i) = cm(i) / n
            Next

            For i = 0 To n - 1        ' Reflexion del simplex respecto de su centro de masas
                r(i) = 2 * cm(i) - x(n, i)
            Next
            If Constrain = True Then Constrain_Point(r)
            yr = getFunct(r, Frm)

            If yr < y(n) Then               'Arbol de decision del Simplex
                If y(1) <= yr Then          'Aceptamos r
                    For i = 0 To n - 1
                        x(n, i) = r(i)
                    Next
                    y(n) = yr
                Else
                    For i = 0 To n - 1      'Expansion del simplex respecto de su centro de masas
                        e(i) = 3 * cm(i) - 2 * x(n, i)
                    Next
                    If Constrain = True Then Constrain_Point(e)
                    ye = getFunct(e, Frm)

                    If ye < yr Then     'Aceptamos e
                        For i = 0 To n - 1
                            x(n, i) = e(i)
                        Next
                        y(n) = ye
                    Else
                        For i = 0 To n - 1  'Aceptamos r
                            x(n, i) = r(i)
                        Next
                        y(n) = yr
                    End If
                End If
            Else
                If yr < y(n + 1) Then
                    For i = 1 To n          ' Contraccion hacia fuera del simplex
                        c(i) = (3 / 2) * cm(i) - (1 / 2) * x(n + 1, i)
                    Next
                    If Constrain = True Then Constrain_Point(c)
                    yc = getFunct(c, Frm)

                    If yc <= yr Then
                        For i = 1 To n  'Aceptamos c
                            x(n + 1, i) = c(i)
                        Next
                        y(n + 1) = yc
                    Else
                        For i = 2 To n + 1      ' Contraccion general del simplex hacia el vertice 1
                            For k = 1 To n
                                x(i, k) = (1 / 2) * (x(1, k) + x(i, k))
                                tp(k) = x(i, k)
                            Next
                            If Constrain = True Then Constrain_Point(tp)
                            y(i) = getFunct(tp, Frm)
                        Next
                    End If
                Else
                    For i = 0 To n - 1       ' Contraccion hacia dentro del simplex
                        cc(i) = (1 / 2) * (cm(i) + x(n, i))
                    Next
                    If Constrain = True Then Constrain_Point(cc)
                    ycc = getFunct(cc, Frm)

                    If ycc < y(n + 1) Then  'Aceptamos c
                        For i = 0 To n - 1
                            x(n, i) = cc(i)
                        Next
                        y(n + 1) = ycc
                    Else

                        For i = 1 To n        ' Contraccion general del simplex hacia el vertice 1
                            For k = 0 To n - 1
                                x(i, k) = (1 / 2) * (x(1, k) + x(i, k))
                                tp(k) = x(i, k)
                            Next
                            If Constrain = True Then Constrain_Point(tp)
                            y(i) = getFunct(tp, Frm)
                        Next
                    End If
                End If
            End If

            Call Orden(x, y)        'Ordenamos los vertices de mejor a peor solucion

            delta = 2 * Math.Abs(y(1) - y(n)) / (Math.Abs(y(1)) + Math.Abs(y(n)) + 0.0000000001)
            its = its + 1
        Loop

        For i = 0 To n - 1
            xsol(i) = x(1, i)
        Next
        ysol = y(1)
        Exit Sub
        '
        'Error_Handler:
        '        Err.Raise(vbObjectError + 513, , Err.Description)
    End Sub

    'Sub NMSimplex(ByRef Frm As Form1, ByVal x(,) As Double, ByVal xsol() As Double, ByVal ysol As Double, ByVal tol As Double, ByVal itmax As Long, ByVal its As Long, Optional ByVal Constrain As Boolean = True)
    '    ' Rutina para buscar el minimo de una funcion segun el algoritmo de Nelder Mead
    '    ' y = fun(x1,x2,...,xn) funcion de R^n a R que se desea optimizar
    '    ' x(1 to n+1,1 to n) vertices del Simplex inicial
    '    ' xsol(1 to n), ysol=fun(xsol) solucion del problema
    '    '
    '    ' Bibliografia
    '    ' Numerical Recipies in Fortran77; W.H. Press, et al.; Cambridge U. Press
    '    ' Metodos numericos con Matlab; J. M Mathewss et al.; Prentice Hall
    '    ' E. Chelouan, et al.; Genetic and Nelder-Mead...; EJOR 148(2003) 335-348
    '    ' J.C. Lagarias, et al.; Convergence properties...; SIAM J Optim. 9(1), 112-147
    '    '
    '    Dim n As Integer    'Dimension del espacio de busqueda
    '    Dim y() As Double

    '    'Reflexion, expansion, 'contracciones y centro de masas del simplex
    '    Dim cm() As Double, r() As Double, e() As Double, c() As Double, cc() As Double
    '    Dim yr As Double, ye As Double, yc As Double, ycc As Double, ycm As Double

    '    Dim delta As Double                  ' tolerancias

    '    Dim tp() As Double
    '    Dim i As Integer, j As Integer, k As Integer

    '    n = UBound(x, 1)            'Dimension del espacio de busqueda
    '    ReDim cm(n), r(n), e(n), c(n), cc(n)
    '    ReDim xsol(n), tp(n), y(n + 1)

    '    ' On Error GoTo Error_Handler

    '    For i = 0 To n - 1       'Evaluamos la funcion en los vertices del simplex
    '        For j = 0 To n - 1
    '            tp(j) = x(i, j)
    '        Next
    '        If Constrain = True Then Constrain_Point(tp)
    '        y(i) = getFunct(tp, Frm)
    '    Next

    '    Call Orden(x, y)            'Ordenamos los vertices de mejor a peor solucion

    '    its = 0
    '    delta = 1
    '    Do While delta >= tol And its < itmax         ' Comienzo de las iteraciones
    '        For i = 0 To n - 1      ' Calculo del centro de masas de los n mejores puntos
    '            cm(i) = 0
    '            For j = 0 To n
    '                cm(i) = cm(i) + x(j, i)
    '            Next
    '            cm(i) = cm(i) / n
    '        Next

    '        For i = 0 To n - 1        ' Reflexion del simplex respecto de su centro de masas
    '            r(i) = 2 * cm(i) - x(n, i)
    '        Next
    '        If Constrain = True Then Constrain_Point(r)
    '        yr = getFunct(r, Frm)

    '        If yr < y(n) Then               'Arbol de decision del Simplex
    '            If y(1) <= yr Then          'Aceptamos r
    '                For i = 0 To n - 1
    '                    x(n, i) = r(i)
    '                Next
    '                y(n) = yr
    '            Else
    '                For i = 0 To n - 1      'Expansion del simplex respecto de su centro de masas
    '                    e(i) = 3 * cm(i) - 2 * x(n, i)
    '                Next
    '                If Constrain = True Then Constrain_Point(e)
    '                ye = getFunct(e, Frm)

    '                If ye < yr Then     'Aceptamos e
    '                    For i = 0 To n - 1
    '                        x(n, i) = e(i)
    '                    Next
    '                    y(n) = ye
    '                Else
    '                    For i = 0 To n - 1  'Aceptamos r
    '                        x(n, i) = r(i)
    '                    Next
    '                    y(n) = yr
    '                End If
    '            End If
    '        Else
    '            If yr < y(n + 1) Then
    '                For i = 1 To n          ' Contraccion hacia fuera del simplex
    '                    c(i) = (3 / 2) * cm(i) - (1 / 2) * x(n + 1, i)
    '                Next
    '                If Constrain = True Then Constrain_Point(c)
    '                yc = getFunct(c, Frm)

    '                If yc <= yr Then
    '                    For i = 1 To n  'Aceptamos c
    '                        x(n + 1, i) = c(i)
    '                    Next
    '                    y(n + 1) = yc
    '                Else
    '                    For i = 2 To n + 1      ' Contraccion general del simplex hacia el vertice 1
    '                        For k = 1 To n
    '                            x(i, k) = (1 / 2) * (x(1, k) + x(i, k))
    '                            tp(k) = x(i, k)
    '                        Next
    '                        If Constrain = True Then Constrain_Point(tp)
    '                        y(i) = getFunct(tp, Frm)
    '                    Next
    '                End If
    '            Else
    '                For i = 0 To n - 1       ' Contraccion hacia dentro del simplex
    '                    cc(i) = (1 / 2) * (cm(i) + x(n, i))
    '                Next
    '                If Constrain = True Then Constrain_Point(cc)
    '                ycc = getFunct(cc, Frm)

    '                If ycc < y(n + 1) Then  'Aceptamos c
    '                    For i = 0 To n - 1
    '                        x(n, i) = cc(i)
    '                    Next
    '                    y(n + 1) = ycc
    '                Else

    '                    For i = 1 To n        ' Contraccion general del simplex hacia el vertice 1
    '                        For k = 0 To n - 1
    '                            x(i, k) = (1 / 2) * (x(1, k) + x(i, k))
    '                            tp(k) = x(i, k)
    '                        Next
    '                        If Constrain = True Then Constrain_Point(tp)
    '                        y(i) = getFunct(tp, Frm)
    '                    Next
    '                End If
    '            End If
    '        End If

    '        Call Orden(x, y)        'Ordenamos los vertices de mejor a peor solucion

    '        delta = 2 * Math.Abs(y(1) - y(n)) / (Math.Abs(y(1)) + Math.Abs(y(n)) + 0.0000000001)
    '        its = its + 1
    '    Loop

    '    For i = 0 To n - 1
    '        xsol(i) = x(1, i)
    '    Next
    '    ysol = y(1)
    '    Exit Sub
    '    '
    '    'Error_Handler:
    '    '        Err.Raise(vbObjectError + 513, , Err.Description)
    'End Sub

    Sub Orden(ByVal x(,) As Double, ByVal y() As Double)
        ' Rutina para ordenar de forma creciante (crescente) segun yi=fun(xi)
        ' x(n+1,n)
        Dim tp() As Double
        Dim i As Integer, j As Integer, k As Integer
        Dim temp As Double, test As Boolean

        ReDim tp(UBound(x, 2))
        For j = 0 To UBound(x, 1) - 1
            test = False
            i = j
            Do While test = False
                If y(j + 1) < y(j) Then
                    temp = y(j)                     ' Intercambio de los valores
                    For k = 0 To UBound(x, 2)
                        tp(k) = x(j, k)
                    Next
                    y(j) = y(j + 1)
                    For k = 0 To UBound(x, 2)
                        x(j, k) = x(j + 1, k)
                    Next
                    y(j + 1) = temp
                    For k = 0 To UBound(x, 2)
                        x(j + 1, k) = tp(k)
                    Next

                    i = i - 1
                    If i = 0 Then
                        test = True
                    End If
                Else
                    test = True
                End If
            Loop
        Next
    End Sub

End Module
